00010	C***************** TO CREATE .CRE FILES FROM XGP FONTS *******
00020	
00030	C TO RUN 'TVFONT'  --- εI (CNTRL-META I)
00040	C     			XREADFO <CR>
00050	C			αO (CNTRL O) = OUTPUT .CRE FILE
00060	C ( β=META )
00070	
00100		IMPLICIT INTEGER(A-Z)
00200		IB=35000
00300		COMMON IZ(1),INODE(35000)
00400		COMMON/IZZ/SIZE,WR
00500	
00600	C INPUT CRE FILE ----------------------------------------------------
00700		TYPE 20
00800		ACCEPT 21,NM,WR
00900		IF(WR)CALL OFILE(1,NM)
01000	20	FORMAT(' TYPE NAME -- '$)
01100	21	FORMAT(A5,I)
01200		CALL GETFIL(NM)
01300		CALL FASTIN(IZ,1)
01400		TYPE 35,IZ(1)
01500	35	FORMAT(' FILE SIZE=',I5/)
01600		IF(IZ(1).LT.IB)GO TO 23
01700		TYPE 24
01800		IZ(1)=IB
01900	24	FORMAT(' INCREASE BUFFER SIZE'/)
02000	23	CALL GETFIL(NM)
02100		CALL FASTIN(IZ,IZ(1))
02200	
02300	C DISPLAY THE IMAGES OF THE FILM ------------------------------------
02400		IMG0=INODE(1)
02500		IMG=IMG0
02600	100	CALL DPYIMG(IMG)
02700		IMG=CW(IMG)
02720		IF(WR)WRITE(1,5)
02760	5	FORMAT(' 999')
02800		GO TO 100
02900		END
     

00100	C DISPLAY IMAGE -----------------------------------------------------
00200		SUBROUTINE DPYIMG(IMG)
00300		COMMON/IZZ/SIZE,WR
00400		DIMENSION DPYBUF(2000)
00500		IMPLICIT INTEGER(A-Z)
00600		CALL DPYSET(1,DPYBUF,2000)
00700		LVL=SON(IMG)
00800		PGN0=SON(LVL)
00900		PGN=PGN0
01000	100	CALL DPYPGN(PGN)
01100		PGN=CCW(PGN)
01200		IF(PGN.NE.PGN0)GO TO 100
01300		CALL DPYOUT(1)
01310		KNT=KNT+1
01320		IF(KNT.LT.TOTAL)RETURN
01330		KNT=0
01400		TYPE 36
01500		ACCEPT 37,Q,TOTAL
01505		WR=0
01510		IF(Q.EQ.'W')WR=-1
01600	37	FORMAT(A1,I)
01700	36	FORMAT(' <CR>=GO ON.'/)
01800		IF(Q.NE.'X')RETURN
01900		END FILE(1)
02000		CALL EXIT
02100		END
02200	C  SELECTION SYSTEM MISSES FIRST ITEM.
     

00100	C DISPLAY POLYGON ---------------------------------------------------
00200		SUBROUTINE DPYPGN(PGN)
00300		COMMON/IZZ/SIZE,WR
00400		IMPLICIT INTEGER(A-Z)
00500		DATA SIZE/5/,MUP/1388/,MLR/1912/
00600		V0=SON(PGN)
00700		V=V0
00800		R=MUP-ROW(V)/SIZE
00900		C=COL(V)/SIZE-MLR
01000		IF(WR)WRITE(1,2)C,R
01100		CALL AIVECT(C,R)
01200	100	V=CCW(V)
01300		R=MUP-ROW(V)/SIZE
01400		C=COL(V)/SIZE-MLR
01500		IF(WR)WRITE(1,3)C,R
01600		CALL AVECT(C,R)
01700		IF(V.NE.V0)GO TO 100
01800	2	FORMAT(2I8,' 3')
01900	3	FORMAT(2I8,' 2')
02000		END
     

00100	C CRE LINKS ---------------------------------------------------------
00200		INTEGER FUNCTION SON(I)
00300		COMMON IZ(1),INODE(35000)
00400		SON=MOD(INODE(I+1),262144)
00500		END
00600	
00700		INTEGER FUNCTION CCW(I)
00800		COMMON IZ(1),INODE(35000)
00900		CCW=MOD(INODE(I),262144)
01000		END
01100	
01200		INTEGER FUNCTION CW(I)
01300		COMMON IZ(1),INODE(35000)
01400		CW=INODE(I)/262144
01500		END
01600	
01700		INTEGER FUNCTION ROW(I)
01800		COMMON IZ(1),INODE(35000)
01900		ROW=INODE(I+1)/262144
02000		END
02100	
02200		INTEGER FUNCTION COL(I)
02300		COMMON IZ(1),INODE(35000)
02400		COL=MOD(INODE(I+1),262144)
02500		END